home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0060_Trap Floating point Errs.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-26  |  6KB  |  141 lines
  1. {
  2.    There was a discussion about  how to trap  floating point errors
  3. in  TP.  Here  is  the   solution that traps   any kind of run-time
  4. errors.  The idea is not mine. I saw it in a russian  book about TP
  5. and OOP.
  6.  
  7.    The idea is quite simple.  Instead of trying to trap all kind of
  8. errors, we  can let TP to do  the job for  us.   Whenever  TP stops
  9. execution of the  program ( because   of a run  time  error or just
  10. because  the program  stops in a  natural  way )  it   executes the
  11. default procedure of exit : ExitProc.  Then TP checks the status of
  12. two variables from  the SYSTEM unit  : ErrorAddr and  ExitCode.  If
  13. there was a run  time error then ErrorAddr  is not NIL and ExitCode
  14. containes the run time error code. Otherwise ExitCode containes the
  15. errorlevel  that  will be    set  for  DOS and  ErrorAddr  is  NIL.
  16. Fortunatly  we can easily  redefine   the  ExitProc,   and  thus to
  17. overtake the control from TP. The problem is that we got to be able
  18. to get back or to jump to any point  of the program  ( even to jump
  19. inside a procedure / function). The author of the book claimed that
  20. he took his routines from Turbo Professional.
  21.  
  22.    Well, there are two files you are gonna need. Save the first one
  23. as JUMP.PAS Compile it as a unit. The second one is a short program
  24. that shows  how to use  it. It  asks for   two numbers, divides the
  25. first  by the second and takes  a  natural logarithm of the result.
  26. Try to divide by zero, logarithm of a negative number. Try entering
  27. letters instead of numbers and see how the program recovers.
  28.  
  29.    The trapping   works  fine under Windows/Dos.   To  run  it with
  30. WINDOWS recompile the JUMP unit for Windows target. Then add WinCrt
  31. to the Uses statement and remove Mark/Release lines ( because there
  32. is no Mark/Release for Windows ).
  33. }
  34.  
  35. Unit Jump;
  36. Interface
  37. Type JumpRecord = Record
  38.                         SpReg,
  39.                         BpReg  : Word;
  40.                         JmpPt  : Pointer;
  41.                   end;
  42.  
  43. Procedure SetJump ( Var JumpDest : JumpRecord );
  44. {Storing SP,BP and the address}
  45. inline(
  46.        $5F/                   {pop di           }
  47.        $07/                   {pop es           }
  48.        $26/$89/$25/           {mov es:[di],sp   }
  49.        $26/$89/$6D/$02/       {mov es:[di+2],bp }
  50.        $E8/$00/$00/           {call null        }
  51.                               {null:            }
  52.        $58/                   {pop ax           }
  53.        $05/$0C/$00/           {add ax,12        }
  54.        $26/$89/$45/$04/       {mov es:[di+4],ax }
  55.        $26/$8C/$4D/$06);      {mov es:[di+6],cs }
  56.                               {next:            }
  57.  
  58. Procedure LongJump ( Var JumpDest : JumpRecord );
  59. {Restore everything and jump}
  60. inline(
  61.        $5F/                   {pop di           }
  62.        $07/                   {pop es           }
  63.        $26/$8B/$25/           {mov sp,es:[di]   }
  64.        $26/$8B/$6D/$02/       {mov bp,es:[di+2] }
  65.        $26/$FF/$6D/$04);      {jmp far es:[di+4]}
  66.  
  67. Implementation
  68. End.
  69.  
  70.  
  71. ------------------------------try.pas------------------------------
  72.  
  73. Program Try;
  74. Uses Jump;                                 {Uses Jump,WinCrt;}
  75. Var
  76.    OldExit : Pointer;
  77.    MyAddr  : JumpRecord;
  78.    MyHeap  : Pointer;
  79.  
  80.    a1,a2,
  81.    a3,a4   : real;
  82.  
  83.  
  84. {$F+}
  85. Procedure MyExit;
  86. {You can add your error handler here}
  87. Begin
  88.      If ErrorAddr<>Nil Then Begin
  89.         case ExitCode of
  90.              106 : Writeln('Invalid numeric format');
  91.              200 : Writeln('Division by zero');
  92.              205 : Writeln('Floating point overflow');
  93.              206 : Writeln('Floating point underflow');
  94.              207 : Writeln('Invalid floating point  operation');
  95.              else  Writeln('Hmmm... How did you do that ?');
  96.         end;
  97.         ErrorAddr:=Nil;
  98.         LongJump(MyAddr);
  99.      end;
  100.      ExitProc:=OldExit;
  101. End;
  102. {$F-}
  103.  
  104. Begin
  105.      OldExit:=ExitProc;
  106.      Mark(MyHeap);        {Just an example of how to restore the heap }
  107.                           {Actually we don't have to do that in       }
  108.                           {this program, because we dont use heap     }
  109.                           {at all. But anyway here it goes            }
  110.                           {Don't forget to remove when compiling this }
  111.                           {for Windows                                       }
  112.  
  113.  
  114.      SetJump(MyAddr);     {We'll get back here whenever a run time    }
  115.                           {error occurs                               }
  116.                           {This line should always be before          }
  117.                           {     ExitProc:=MyExit;                     }
  118.                           {Don't ask me why... It's much easier for me}
  119.                           {to follow the rule then to understand it :)}
  120.      ExitProc:=@MyExit;
  121.  
  122.      Release(MyHeap);      {restoring the heap after a run time error }
  123.                            {Remove this if you are compiling it for   }
  124.                            {Windows                                   }
  125.  
  126.                            {Try entering whatever you want at the     }
  127.                            {prompt. It should trap every runtime error}
  128.                            {you could possibly get.                   }
  129.      Repeat
  130.            Writeln;
  131.            Write('Enter a number a1=');
  132.            Readln(a1);
  133.            Write('Enter a number a2=');
  134.            Readln(a2);
  135.            a3:=a1/a2;
  136.            Writeln('a1/a2=',a3:10:5);
  137.            a4:=ln(a3);
  138.            Writeln('ln(a1/a2)=',a4:10:5);
  139.      until a3=1;
  140. end.
  141.